C--------------------------------------------------------------------------- 

C Program name: Colour naming scheme test program.

C Author: Gareth Williams

C Description:

C Modification history : (Version), (Date), (Name), (Description).

C 1.0, 18th February 1991, G. Williams, First Version.

C 2.0, June 1992, G. Williams, Converted to SunPHIGS 2.0.

C----------------------------------------------------------------------------

       PROGRAM cnstest
       LOGICAL ptkf_readphinterscript

       include './sunphigs77.h'
       include './sunptk77.h'

       implicit undefined (P, p, E, e)
         
C     open PHIGS 
       print *,('Demonstrating the colour naming scheme of the 
& PHIGS Toolkit...')
       print *,('Opening SunPHIGS...')

       call popph(6, 0)
 
C     create the workstation type (either tool or canvas) 
              
C     open the workstation 

       if (ptkf_readphinterscript('../../scripts/openws.scr', 0, 0) .eq.
& .FALSE.) then     
         goto 20
       endif

       call psdus(1, PWAITD, PNIVE)

       call ptkf_inithashtables()
       call ptkf_createhashtable('colourindex', 1, 256)
         
       call ptkf_setcolourrep(1, 'RED')

       call ptkf_drawcolourtable(1, 1, 1)  
       call ppost(1, 1, 0.0)

       call prst(1, PALWAY)
         
       call options()
         
 20    print *,('Closing PHIGS...')
       call pclwk(1)
       call pclph()

       STOP
       END

C--------------------------------------------------------------------------
      
       SUBROUTINE outputcolourvalues(inum, colourname, rgb)
       INTEGER inum
       CHARACTER*(*) colourname
       REAL rgb(3)
       REAL hsv(3), hsl(3)

       implicit undefined (P, p, E, e)
      
       print *, inum, ') RGB value of ', colourname, ' is ',
& rgb(1), rgb(2), rgb(3)
       call ptkf_rgbtohsv(rgb, hsv)
       print *, inum, ') HSV value of ', colourname, ' is ', 
& hsv(1), hsv(2), hsv(3) 
       call ptkf_rgbtohsl(rgb, hsl)
       print *, inum, ') HSL value of ', colourname, ' is ', 
& hsl(1), hsl(2), hsl(3) 

       RETURN
       END
      
C--------------------------------------------------------------------------
      
       SUBROUTINE options()
       CHARACTER*50 colourname
       INTEGER lencolourname
       LOGICAL cnsquit
       REAL echoarea(4)
       REAL rgb(3)

       include './sunphigs77.h'

       implicit undefined (P, p, E, e)
      
       cnsquit = .FALSE.
       call ptkf_limit(0.0, 0.25, 0.0, 0.01, echoarea)
 10    call ptkf_readstring(1, 'white', 'Input colourname (white) >',
& echoarea, 50 , colourname, lencolourname)
       if (colourname(1:lencolourname) .eq. 'quit') then
         cnsquit = .TRUE.
       else
         call ptkf_cnstorgb(colourname(1:lencolourname), rgb)
         call pscr(1, 1, 3, rgb)
         call pemst(1)
         call ptkf_drawcolourtable(1, 1, 1)      
         call outputcolourvalues(1, colourname, rgb)
       endif

       call prst(1, PALWAY)

       if (cnsquit .eq. .FALSE.) then
         goto 10
       endif

       RETURN
       END

C--------------------------------------------------------------------------

C end of cnstest.f
